Dim doc
Set doc = application.ActiveDocument
ValidateServer(doc)
dim cside:cside =1
main
sub main()
	dim npnts
	dim pntArr
	doc.CurrentUnit = 2
	dim fabobj,fabColl
	set fabColl = doc.FabricationLayerGfxs(-1,1,0,false) 
	for each fabobj in fabColl
		pntArr = fabobj.Geometry.PointsArray
		npnts = UBound(pntArr,2) +1	
		exit for
	next
	msgbox fabColl.count
	if fabColl.count=0 then
		Dim obs
		Set obs = doc.ConductiveAreas(1, 0)
		If obs.Count = 0 Then Exit Sub
		dim ob
		Dim obNet, obLayer
		Dim numPoints, PntsArr
		For Each ob In obs
			pntArr = ob.Geometry.PointsArray  
			npnts = UBound(pntArr,2) + 1
			exit for
		Next
	end if
	
	dim dx:dx =100
	
	dim gndnet
	set gndnet = doc.findnet("GND")
	dim ViaPadstack
	Set ViaPadstack = doc.PutPadstack(1, doc.layercount, "016-8VIA", False, True)         	 
	dim i
	dim ox0,oy0
	dim ox,oy
	dim oy1
	dim ischeck
	for i=0 to npnts-1
		'msgbox i
		ischeck = 1
		ox = pntArr(0,i):oy=pntArr(1,i)		
		
		if pntArr(2,i)=0 then
			call doc.putvia(ox,oy,ViaPadstack,gndnet,NOTHING,2,epcbUnitCurrent)	
			if i>1 then if pntArr(2,i-1)<>0 then ischeck = 0
			'if i<npnts-2 then if pntArr(2,i+1)<>0 then ischeck = 0
		else
			ischeck = 0
		end if
			
		if ischeck = 1 and ox0<>"" and oy0<>"" then 
			if ox=ox0 then
				if abs(oy-oy0)>dx then
					if oy>oy0 then
						oy1 = oy0+dx
						do while oy>oy1							
							call doc.putvia(ox,oy1,ViaPadstack,gndnet,NOTHING,2,epcbUnitCurrent)
							oy1= oy1+dx
						loop
					else
						oy1 = oy0-dx
						do while oy<oy1							
							call doc.putvia(ox,oy1,ViaPadstack,gndnet,NOTHING,2,epcbUnitCurrent)
							oy1= oy1-dx
						loop
					end if
				end if
			end if
			
			if oy=oy0 then
				if abs(ox-ox0)>dx then
					if ox>ox0 then
						ox1 = ox0+dx
						do while ox>ox1							
							call doc.putvia(ox1,oy,ViaPadstack,gndnet,NOTHING,2,epcbUnitCurrent)
							ox1 = ox1+dx
						loop
					else
						ox1 = ox0-dx
						do while ox<ox1
							call doc.putvia(ox1,oy,ViaPadstack,gndnet,NOTHING,2,epcbUnitCurrent)
							ox1 = ox1-dx
						loop
					end if
				end if
			end if
			
			dim k
			if ox<>ox0 and oy<>oy0 then
				k = (oy-oy0)/(ox-ox0)
				if abs(ox-ox0)>abs(oy-oy0) then
					if ox>ox0 then
						ox1 = ox0+0.5*dx
						oy1 = k * (ox1-ox0)+oy0
						do while ox>ox1							
							call doc.putvia(ox1,oy1,ViaPadstack,gndnet,NOTHING,2,epcbUnitCurrent)
							ox1 = ox1+0.5*dx
							oy1 = k * (ox1-ox0)+oy0
						loop
					else
						ox1 = ox0-0.5*dx
						oy1 = k * (ox1-ox0)+oy0
						do while ox<ox1							
							call doc.putvia(ox1,oy1,ViaPadstack,gndnet,NOTHING,2,epcbUnitCurrent)
							ox1 = ox1-0.5*dx
							oy1 = k * (ox1-ox0)+oy0
						loop
					end if	
				else
					if oy>oy0 then
						oy1 = oy0+0.5*dx
						ox1 = k * (oy1-oy0)+ox0	
						do while oy>oy1							
							call doc.putvia(ox1,oy1,ViaPadstack,gndnet,NOTHING,2,epcbUnitCurrent)
							oy1 = oy1+0.5*dx
							ox1 = k * (oy1-oy0)+ox0
						loop
					else
						oy1 = oy0-0.5*dx
						ox1 = k * (oy1-oy0)+ox0	
						do while oy<oy1							
							call doc.putvia(ox1,oy1,ViaPadstack,gndnet,NOTHING,2,epcbUnitCurrent)
							oy1 = oy1-0.5*dx
							ox1 = k * (oy1-oy0)+ox0
						loop
					end if
				end if	
			end if
		end if
		ox0 = ox:oy0=oy
	next
	msgbox "done!"
end sub

'---------------------------------------
' Begin Validate Server Function
'---------------------------------------
Private Function ValidateServer(doc)    
    Dim key, licenseServer, licenseToken
    ' Ask Expedition抯 document for the key
    key = doc.Validate(0)
    ' Get license server
    Set licenseServer = CreateObject("MGCPCBAutomationLicensing.Application")
    ' Ask the license server for the license token
    licenseToken = licenseServer.GetToken(key)
    ' Release license server
    Set licenseServer = Nothing
    ' Turn off error messages.  Validate may fail if the token is incorrect
    On Error Resume Next
    Err.Clear

    ' Ask the document to validate the license token
    doc.Validate (licenseToken)
    If Err Then
        ValidateServer = 0
    Else
        ValidateServer = 1
    End If
End Function
'---------------------------------------
' End Validate Server Function
'---------------------------------------

